# load packages
if (!require(tidyverse)) {
install.packages('tidyverse')
}
if (!require(lmerTest)) {
install.packages('lmerTest')
}
if (!require(purrr)) {
install.packages('purrr')
}
if (!require(ggpubr)) {
install.packages('ggpubr')
}
devtools::install_github("dcosme/specr", ref = "plotmods")
devtools::install_github("hadley/emo")
# define aesthetics
palette = c("#e64626", "#ffb800", "#00A896","#1985a1", "#165F8D", "#5A69AF", "#393993")
palette_content = c("#e64626", "#ffb800", "#00A896","#1985a1", "#5A69AF")
palette_sharing = c("#4c5c68", "#B8B3BE")
palette_relevance = c("#A42B13", "#EE6C4D", "#3D5A80", "#98C1D9")
plot_aes = theme_minimal() +
theme(legend.position = "top",
legend.text = element_text(size = 12),
text = element_text(size = 16, family = "Futura Medium"),
axis.text = element_text(color = "black"),
axis.line = element_line(colour = "black"),
axis.ticks.y = element_blank())
# demos
study1_demo = read.csv("../data/study1_demo.csv", stringsAsFactors = FALSE)
study2_demo = read.csv("../data/study2_demo.csv", stringsAsFactors = FALSE)
study3_demo = read.csv("../data/study3_demo.csv", stringsAsFactors = FALSE)
study4_demo = read.csv("../data/study4_demo.csv", stringsAsFactors = FALSE)
study5_demo = read.csv("../data/study5_demo.csv", stringsAsFactors = FALSE)
study6_demo = read.csv("../data/study6_demo.csv", stringsAsFactors = FALSE)
merged_demo = bind_rows(study1_demo, study2_demo, study3_demo, study4_demo, study5_demo, study6_demo) %>%
spread(item, value) %>%
select(-gender_4_TEXT, -race_self) %>%
rename("SES_degree" = `highest degree completed`,
"SES_income" = `household income`,
"hispanic_latinx" = `Hispanic or Latinx`) %>%
mutate(age = as.numeric(age))
# load and tidy data
study1 = read.csv("../data/study1.csv", stringsAsFactors = FALSE)
study2 = read.csv("../data/study2.csv", stringsAsFactors = FALSE)
study3 = read.csv("../data/study3.csv", stringsAsFactors = FALSE)
study4 = read.csv("../data/study4.csv", stringsAsFactors = FALSE)
study5 = read.csv("../data/study5.csv", stringsAsFactors = FALSE)
study6 = read.csv("../data/study6.csv", stringsAsFactors = FALSE)
merged = bind_rows(study1, study2, study3, study4, study5, study6) %>%
group_by(study, sharing_type) %>%
mutate(msg_share_std = scale(msg_share, scale = TRUE, center = TRUE),
medium = ifelse(grepl("1|2|3", study), "social media", "newspaper")) %>%
left_join(., merged_demo) %>%
mutate(gender = as.factor(gender),
hispanic_latinx = as.factor(hispanic_latinx),
race = ifelse(race == "Hispanic" | race == "Latino", NA, race),
race = as.factor(race),
SES_degree = factor(SES_degree, ordered = TRUE,
levels = c("Less than high school", "High school graduate (diploma)",
"High school graduate (GED)",
"Some college (1-4 years, no degree)",
"Associate's degree (including occupational or academic degrees)",
"Bachelor's degree (BA, BS, etc)",
"Master's degree (MA, MS, MENG, MSW, etc)",
"Professional school degree (MD, DDC, JD, etc)",
"Doctorate degree (PhD, EdD, etc)")),
SES_income = factor(SES_income, ordered = TRUE,
levels = c("Less than $5,000",
"$5,000 through $11,999",
"$12,000 through $15,999",
"$16,000 through $24,999",
"$25,000 through $34,999",
"$35,000 through $49,999",
"$50,000 through $74,999",
"$75,000 through $99,999",
"$100,000 and greater")))# specify model components
dvs = "msg_share_std"
ivs = c("msg_rel_self_between", "msg_rel_self_within", "msg_rel_social_between", "msg_rel_social_within")
control_vars = c("age", "gender", "SES_degree", "SES_income", "race", "hispanic_latinx")
model = "lmer"
random_effects = "(1 + msg_rel_self_within + msg_rel_social_within | SID) + (1 | item)"
# generate all combinations of control variables
controls = do.call(c, lapply(1:length(control_vars), function(x) combinat::combn(control_vars, x, simplify = FALSE))) %>%
purrr::map(function(x) paste(x, collapse = " + ")) %>%
unlist() %>%
append(., "") # no covariates
# controls = c("age", "gender", "SES_degree", "SES_income", "race", "hispanic_latinx", "")
# get relevant variables
model_df = merged %>%
select(study, SID, item, content, sharing_type, medium, !!dvs, !!ivs, !!control_vars) %>%
mutate(sharing_type = ifelse(sharing_type == 0, "broadcast", "narrowcast"))
subsets_1 = list(content = "covid",
sharing_type = "broadcast")
subsets_2 = list(sharing_type = unique(model_df$sharing_type),
medium = unique(model_df$medium))
subsets_3 = list(content = unique(model_df$content),
sharing_type = unique(model_df$sharing_type),
medium = unique(model_df$medium))
# generate model specifications from model components
models = expand.grid(x = ivs,
y = dvs,
model = model,
controls = controls,
control_ivs = paste(ivs, collapse = " _ "),
random_effects = random_effects, stringsAsFactors = FALSE) %>%
mutate(control_ivs = str_remove(control_ivs, x),
control_ivs = str_replace(control_ivs, "^ _ ", ""),
control_ivs = str_replace(control_ivs, " _ $", ""),
control_ivs = str_replace(control_ivs, " _ _ ", " _ "),
control_ivs = gsub(" _ ", " + ", control_ivs, fixed = TRUE),
controls = ifelse(controls == "", control_ivs,
sprintf("%s + %s", control_ivs, controls))) %>%
select(-control_ivs) %>%
as_tibble()conf.level = .95
# specr functions
convert_formula = function(x, y, controls, random_effects, ...) {
if (controls == "no covariates") {
paste(y, "~", x, "+", random_effects)
} else {
paste(y, "~", x, "+", controls, "+", random_effects)
}
}
run_spec <- function(specs, df, conf.level, keep.results = FALSE) {
# dependencies
require(dplyr)
require(purrr)
results <- specs %>%
mutate(formula = pmap(., convert_formula)) %>%
tidyr::unnest(formula) %>%
mutate(res = map2(model, formula, possibly(~ do.call(.x, list(data = df,
formula = .y,
control = lmerControl(optimizer = "bobyqa"))),
otherwise = NULL))) %>%
filter(!res == "NULL") %>%
mutate(coefs = map(res,
broom.mixed::tidy,
conf.int = TRUE,
conf.level = .95),
obs = map(res, nobs)) %>%
tidyr::unnest(coefs) %>%
tidyr::unnest(obs) %>%
filter(term == x) %>%
select(-term)
if (isFALSE(keep.results)) {
results <- results %>%
select(-res)
}
return(results)
}
create_subsets <- function(df, subsets) {
# dependencies
require(dplyr)
subsets %>%
stack %>%
purrr::pmap(~ filter(df, get(as.character(..2)) == ..1) %>%
mutate(filter = paste(..2, "=", ..1)))
}
# individual subsets
subsets_1 <- map(subsets_1, as.character)
df_comb_1 <- subsets_1 %>%
cross %>%
map(~ create_subsets(subsets = .x, df = model_df) %>%
map(~ dplyr::select(.x, -filter)) %>%
reduce(dplyr::inner_join) %>%
dplyr::mutate(filter = paste(names(.x),
.x,
collapse = " & ",
sep = " = "))) %>%
Filter(function(x) nrow(x) > 0, .) # filter out empty dataframes
# medium, sharing type
subsets_2 <- map(subsets_2, as.character)
df_comb_2 <- subsets_2 %>%
cross %>%
map(~ create_subsets(subsets = .x, df = model_df) %>%
map(~ dplyr::select(.x, -filter)) %>%
reduce(dplyr::inner_join) %>%
dplyr::mutate(filter = paste(names(.x),
.x,
collapse = " & ",
sep = " = "))) %>%
Filter(function(x) nrow(x) > 0, .) %>% # filter out empty dataframes
Filter(function(x) sum(x$filter == "sharing_type = narrowcast & medium = social media") == 0, .)
# content, medium, sharing type
subsets_3 <- map(subsets_3, as.character)
df_comb_3 <- subsets_3 %>%
cross %>%
map(~ create_subsets(subsets = .x, df = model_df) %>%
map(~ dplyr::select(.x, -filter)) %>%
reduce(dplyr::inner_join) %>%
dplyr::mutate(filter = paste(names(.x),
.x,
collapse = " & ",
sep = " = "))) %>%
Filter(function(x) nrow(x) > 0, .) # filter out empty dataframes
# combine
df_comb_12 <- append(df_comb_1, df_comb_2)# library(furrr)
# plan(multisession, workers = 10)
# output_a = future_map_dfr(df_comb_12, ~ run_spec(models, .x, conf.level = .95, keep.results = TRUE) %>%
# mutate(subsets = unique(.x$filter)))
# saveRDS(output_a, "models/sca_output_a_demo.RDS")
#
# output_b = future_map_dfr(df_comb_3, ~ run_spec(models, .x, conf.level = .95, keep.results = TRUE) %>%
# mutate(subsets = unique(.x$filter)))
# saveRDS(output_b, "models/sca_output_b_demo.RDS")
# output_a = readRDS("models/sca_output_a_demo.RDS") %>% select(-res)
# output_b = readRDS("models/sca_output_b_demo.RDS") %>% select(-res)
output_a = readRDS("models/sca_output_a.RDS") %>% select(-res)
output_b1 = readRDS("models/sca_output_b1.RDS") %>% select(-res)
output_b2 = readRDS("models/sca_output_b2.RDS") %>% select(-res)output1 = bind_rows(output_a, output_b1, output_b2) %>%
#output1 = bind_rows(output_a, output_b) %>%
mutate(x = gsub("msg_rel_", "", x),
x = gsub("_", " ", x),
content = ifelse(grepl("covid", subsets), "COVID-19",
ifelse(grepl("voting", subsets), "voting",
ifelse(grepl("health", subsets), "health",
ifelse(grepl("climate", subsets), "climate",
ifelse(subsets == "sharing_type = broadcast & medium = social media", "COVID-19 & voting",
ifelse(subsets == "sharing_type = broadcast & medium = newspaper", "COVID-19, health & climate",
ifelse(subsets == "sharing_type = narrowcast & medium = newspaper", "COVID-19 & climate", "all"))))))),
`COVID-19` = ifelse(grepl("COVID-19", content), "COVID-19", NA),
voting = ifelse(grepl("voting", content), "voting", NA),
health = ifelse(grepl("health", content), "health", NA),
climate = ifelse(grepl("climate", content), "climate", NA),
sharing = ifelse(grepl("broad", subsets), "broadcast",
ifelse(grepl("narrow", subsets), "narrowcast", "all")),
medium = ifelse(grepl("media", subsets), "social media",
ifelse(subsets == "content = covid & sharing_type = broadcast", "social media",
ifelse(grepl("news", subsets), "newspaper", "all"))),
relevance = x,
controls = ifelse(grepl("age|SES|race|hispanic", controls), "controls", "no controls"),
subset = case_when(subsets == "content = covid & sharing_type = broadcast" ~ "10",
subsets == "sharing_type = broadcast & medium = social media" ~ "11",
subsets == "sharing_type = broadcast & medium = newspaper" ~ "12",
subsets == "sharing_type = narrowcast & medium = newspaper" ~ "13",
subsets == "content = covid & sharing_type = broadcast & medium = social media" ~ "1",
subsets == "content = voting & sharing_type = broadcast & medium = social media" ~ "4",
subsets == "content = voting & sharing_type = narrowcast & medium = social media" ~ "5",
subsets == "content = covid & sharing_type = broadcast & medium = newspaper" ~ "2",
subsets == "content = health & sharing_type = broadcast & medium = newspaper" ~ "6",
subsets == "content = climate & sharing_type = broadcast & medium = newspaper" ~ "8",
subsets == "content = covid & sharing_type = narrowcast & medium = newspaper" ~ "3",
subsets == "content = health & sharing_type = narrowcast & medium = newspaper" ~ "7",
subsets == "content = climate & sharing_type = narrowcast & medium = newspaper" ~ "9"))# define edges
l1 = expand.grid(from = dvs, to = ivs) %>%
group_by(to) %>%
mutate(key = "relevance variables",
to = sprintf("%s_%s", to, row_number()))
l2 = expand.grid(from = unique(l1$to), to = controls) %>%
group_by(to) %>%
mutate(key = "control variables",
to = sprintf("%s_%s", to, row_number()))
edge_list = bind_rows(l1, l2)
# plot
decision_plot = igraph::graph_from_data_frame(edge_list)
ggraph::ggraph(decision_plot, layout = 'dendrogram', circular = FALSE) +
ggraph::geom_edge_diagonal(aes(color = key), strength = 0) +
ggraph::scale_edge_color_manual(name = "decision key", values = wesanderson::wes_palette("Zissou1", 3, "continuous")) +
theme_void() +
theme(legend.position = "top")format_results <- function(df, var, null = 0, desc = FALSE) {
# rank specs
if (isFALSE(desc)) {
df <- df %>%
dplyr::arrange(estimate)
} else {
df <- df %>%
dplyr::arrange(desc(estimate))
}
# create rank variable and color significance
df <- df %>%
dplyr::mutate(specifications = 1:n(),
color = case_when(conf.low > null ~ "black",
conf.high < null ~ "black",
TRUE ~ "darkgrey"))
return(df)
}
plot_choices <- function(df,
var = .data$estimate,
choices = c("x", "y", "model", "controls", "subsets"),
desc = FALSE,
null = 0,
size = 3.35,
alpha_values = c(1, 1),
color_vars = NULL,
palette = NULL,
rename_controls = FALSE,
ignore_vars = FALSE,
collapse_content = FALSE) {
value <- key <- NULL
var <- enquo(var)
if (collapse_content == TRUE) {
df = df %>%
format_results(var = var, null = null, desc = desc) %>%
select(-content) %>%
gather(content_type, content, `COVID-19`, voting, health, climate) %>%
filter(!is.na(content)) %>%
select(-content_type)
} else {
df = df %>%
format_results(var = var, null = null, desc = desc)
}
if (!is.null(color_vars)) {
color_num_key = df %>%
select(!!color_vars) %>%
unique() %>%
arrange(get(color_vars)) %>%
mutate(color_num = row_number())
data_df = df %>%
left_join(., color_num_key) %>%
mutate(controls = ifelse(grepl("[+]", controls), "all covariates", controls),
alpha = ifelse(color == "black", "yes", "no"),
color = sprintf("%s", eval(parse(text = "palette[color_num]")))) %>%
tidyr::gather(key, value, choices) %>%
mutate(key = ifelse(isFALSE(rename_controls) == FALSE & key == "controls", rename_controls, key),
value = ifelse(isFALSE(ignore_vars) == FALSE & value %in% ignore_vars, NA, value)) %>%
filter(!is.na(value)) %>%
unique() %>%
mutate(key = factor(key, levels=unique(key)))
} else {
data_df = df %>%
mutate(controls = ifelse(grepl("[+]", controls), "all covariates", controls)) %>%
tidyr::gather(key, value, choices) %>%
mutate(key = ifelse(isFALSE(rename_controls) == FALSE & key == "controls", rename_controls, key),
value = ifelse(isFALSE(ignore_vars) == FALSE & value %in% ignore_vars, NA, value),
alpha = "yes") %>%
filter(!is.na(value)) %>%
unique() %>%
mutate(key = factor(key, levels=unique(key)))
}
data_df %>%
ggplot(aes(x = .data$specifications,
y = .data$value,
color = .data$color)) +
geom_point(aes(x = .data$specifications,
y = .data$value,
alpha = alpha),
shape = 124,
size = size) +
scale_color_identity() +
scale_alpha_manual(values = alpha_values) +
theme_minimal() +
facet_grid(.data$key~1, scales = "free_y", space = "free_y") +
theme(
axis.line = element_line("black", size = .5),
legend.position = "none",
panel.spacing = unit(.75, "lines"),
axis.text = element_text(colour = "black"),
strip.text.x = element_blank()) +
labs(x = "", y = "")
}plot_sca = function(data, combined = TRUE, labels = c("A", "B"),
title = FALSE, limits = NULL,
point_size = .1, point_alpha = 1,
ci = TRUE, ci_alpha = .5, ci_size = .1,
line = FALSE, line_size = 1,
median_alpha = 1, median_size = 1,
text_size = 14, title_size = 6,
color_vars = NULL, palette = palette, legend = TRUE,
choices = c("x", "content", "medium", "sharing", "controls"),
alpha_values = c(0.5, 1),
remove_y = FALSE, remove_facet = FALSE,
collapse_content = FALSE) {
medians = data %>%
group_by(get(color_vars)) %>%
summarize(median = median(estimate)) %>%
ungroup() %>%
mutate(color = sprintf("%s", palette))
if (combined == TRUE) {
p1 = specr::plot_curve(data, point_size = point_size, point_alpha = point_alpha,
ci = ci, ci_alpha = ci_alpha, ci_size = ci_size,
line = line, line_size = line_size,
limits = limits) +
geom_hline(data = medians, aes(yintercept = median, color = color, linetype = `get(color_vars)`),
alpha = median_alpha, size = median_size, show_guide = TRUE) +
scale_linetype_manual(name = "", values = rep(1, nrow(medians)),
guide = guide_legend(override.aes = list(color = palette))) +
labs(x = "", y = "standarized\nregression coefficient\n") +
theme(legend.position = "top",
text = element_text(size = text_size, family = "Futura Medium"))
if (legend == FALSE) {
p1 = p1 +
theme(legend.position = "none")
}
if (title == TRUE) {
if (is.null(limits)) {
title_range = max(data$conf.high) - min(data$conf.high)
title_y = max(data$conf.high) - (title_range / 10)
} else {
title_range = limits[2] - limits[1]
title_y = limits[2] - (title_range / 10)
}
p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$x), fontface = 2, size = title_size,
x = 0.5*(1 + nrow(data)),
y = title_y)
}
if (!is.null(color_vars)) {
p2 = plot_choices(data, choices = choices,
alpha_values = alpha_values, color_vars = color_vars,
palette = palette, collapse_content = collapse_content) +
labs(x = "\nspecifications (ranked)") +
theme(strip.text.x = element_blank(),
text = element_text(size = text_size, family = "Futura Medium"))
} else {
p2 = plot_choices(data, choices = choices,
alpha_values = alpha_values, collapse_content = collapse_content) +
labs(x = "\nspecifications (ranked)") +
theme(strip.text.x = element_blank(),
text = element_text(size = text_size, family = "Futura Medium"))
}
} else {
p1 = specr::plot_curve(data, point_size = point_size, point_alpha = point_alpha,
ci_alpha = ci_alpha, ci_size = ci_size) +
geom_hline(yintercept = 0, linetype = "solid", color = "black", size = .5) +
labs(x = "", y = "standarized\nregression coefficient\n") +
theme(text = element_text(size = text_size, family = "Futura Medium"))
if (title == TRUE) {
if (is.null(limits)) {
title_range = max(data$conf.high) - min(data$conf.high)
title_y = max(data$conf.high) - (title_range / 10)
} else {
title_range = limits[2] - limits[1]
title_y = limits[2] - (title_range / 10)
}
p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$y), fontface = 2, size = title_size,
x = 0.5*(1 + nrow(data)),
y = title_y)
}
p2 = plot_choices(data, choices = choices,
alpha_values = alpha_values, collapse_content = collapse_content) +
labs(x = "\nspecification number (ranked)") +
theme(strip.text.x = element_blank(),
text = element_text(size = text_size, family = "Futura Medium"))
}
if (remove_y == TRUE) {
p1 = p1 + labs(y = "")
p2 = p2 + theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
labs(y = "")
}
if (remove_facet == TRUE) {
p2 = p2 + theme(strip.text.y = element_blank())
}
specr::plot_specs(plot_a = p1,
plot_b = p2,
labels = labels,
rel_height = c(.35, .65))
}
plot_sca_compare = function(data, pointrange = TRUE, labels = c("A", "B"),
rel_heights = c(.75, .25), rel_widths = c(.75, .25),
title = FALSE, text_size = 14, title_size = 6, n_rows = 1, angle_text = FALSE,
remove_x = FALSE, remove_y = FALSE, sig = NULL) {
# source raincloud plot
source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")
# merge and tidy for plotting
plot_data = data %>%
group_by(x) %>%
arrange(estimate) %>%
mutate(specification = row_number()) %>%
ungroup() %>%
unique()
# labels
median_cl_boot = function(x, conf = 0.95, df = TRUE, ci = "low") {
lconf = (1 - conf)/2
uconf = 1 - lconf
require(boot)
bmedian = function(x, ind) median(x[ind])
bt = boot(x, bmedian, 1000)
bb = boot.ci(bt, type = "perc")
if (df == TRUE){
data.frame(y = median(x),
ymin = quantile(bt$t, lconf),
ymax = quantile(bt$t, uconf))
} else {
if (ci == "low") {
quantile(bt$t, lconf)
} else {
quantile(bt$t, uconf)
}
}
}
labs = plot_data %>%
group_by(x) %>%
summarize(med = median(estimate),
low = median_cl_boot(estimate, df = FALSE, ci = "low"),
high = median_cl_boot(estimate, df = FALSE, ci = "high")) %>%
mutate(range = max(high) - min(low),
estimate = ifelse(med > 0, high + (range / 10), low - (range / 10)),
label = ifelse(x %in% sig, "*", ""))
# plot curves
if (pointrange == TRUE) {
a = plot_data %>%
ggplot(aes(specification, estimate, color = x)) +
geom_linerange(aes(ymin = conf.low, ymax = conf.high), size = .1) +
geom_point() +
geom_hline(yintercept = 0, linetype = "solid", color = "black", size = 1) +
scale_color_manual(name = "", values = palette_relevance) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 4)) +
labs(x = "\nspecification number (ranked)", y = "standarized\negression coefficient\n") +
theme_minimal() +
theme(strip.text = element_blank(),
axis.line = element_line("black", size = 0.5),
legend.position = c(.5, .1),
legend.direction = "horizontal",
panel.spacing = unit(0.75, "lines"),
axis.text = element_text(colour = "black"),
text = element_text(size = text_size, family = "Futura Medium"))
if (title == TRUE) {
a = a + annotate("text", -Inf, Inf, label = unique(plot.data$y), fontface = 2, size = title_size,
x = 0.5*(min(plot.data$specification) + max(plot.data$specification)),
y = max(plot.data$conf.high))
}
} else {
a = plot_data %>%
ggplot(aes(specification, estimate, color = x)) +
geom_point() +
geom_hline(yintercept = 0, linetype = "solid", color = "black", size = 1) +
scale_color_manual(name = "", values = palette_relevance) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 4)) +
labs(x = "\nspecification number (ranked)", y = "standarized\nregression coefficient\n") +
theme_minimal() +
theme(strip.text = element_blank(),
axis.line = element_line("black", size = 0.5),
legend.position = "none",
legend.direction = "horizontal",
panel.spacing = unit(0.75, "lines"),
axis.text = element_text(colour = "black"),
text = element_text(size = text_size, family = "Futura Medium"))
if (title == TRUE) {
a = a + annotate("text", -Inf, Inf, label = unique(plot.data$y), fontface = 2, size = title_size,
x = 0.5*(min(plot.data$specification) + max(plot.data$specification)),
y = max(plot.data$estimate))
}
}
b = plot_data %>%
group_by(x) %>%
mutate(order = median(estimate)) %>%
ggplot(aes(reorder(x, order), estimate, fill = x)) +
geom_flat_violin(position = position_nudge(x = .1, y = 0), color = FALSE) +
geom_point(aes(color = x), position = position_jitter(width = .05), size = .1, alpha = .1) +
geom_boxplot(width = .1, outlier.shape = NA, fill = NA) +
geom_text(data = labs, aes(label = label, x = x, y = estimate), size = 6) +
scale_fill_manual(name = "", values = palette_relevance) +
scale_color_manual(name = "", values = palette_relevance) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 4)) +
labs(x = "\n", y = "standarized\nregression coefficient\n") +
theme_minimal() +
theme(strip.text = element_blank(),
axis.line = element_line("black", size = 0.5),
legend.position = "none",
panel.spacing = unit(0.75, "lines"),
axis.text = element_text(colour = "black"),
text = element_text(size = text_size, family = "Futura Medium"))
if (angle_text == TRUE) {
b = b + theme(axis.text.x = element_text(angle = 45, hjust = 1))
}
if (n_rows == 1) {
a = a + theme(legend.position = c(.5, .1))
b = b + coord_flip() +
labs(x = "\n", y = "\nmedian") +
theme(axis.text.x = element_text(angle = 0, hjust = 1),
axis.text.y = element_blank())
}
if (remove_x == TRUE) {
a = a + labs(x = "")
if (n_rows == 1) {
b = b + labs(y = "")
} else {
b = b + labs(x = "")
}
}
if (remove_y == TRUE) {
a = a + labs(y = "")
if (n_rows == 1) {
b = b + labs(x = "")
} else {
b = b + labs(y = "")
}
}
cowplot::plot_grid(a, b, labels = labels, rel_heights = rel_heights, rel_widths = rel_widths, nrow = n_rows)
}plot_sca(data = output1, combined = TRUE, title = FALSE, text_size = 20, median_size = 1.25,
color_vars = "x", palette = palette_relevance, alpha_values = c(.2, .5),
choices = c("relevance", "content", "medium", "sharing", "controls"),
collapse_content = TRUE)self_between = plot_sca(data = filter(output1, grepl("self between", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(1, 1), text_size = 18,
color_vars = "medium", palette = palette[3:4],
remove_facet = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls"), limits = c(-.3, 1),
collapse_content = TRUE)
social_between = plot_sca(data = filter(output1, grepl("social between", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(.5, 1), text_size = 18,
color_vars = "medium", palette = palette[3:4],
remove_y = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls"), limits = c(-.3, 1),
collapse_content = TRUE)
ggarrange(self_between, social_between, ncol = 2, labels = c("A", "B"), widths = c(.51, .49))self_within = plot_sca(data = filter(output1, grepl("self within", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(1, 1), text_size = 18,
color_vars = "sharing", palette = palette_sharing,
remove_facet = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls"), limits = c(-0, .4),
collapse_content = TRUE)
social_within = plot_sca(data = filter(output1, grepl("social within", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(1, 1), text_size = 18,
color_vars = "sharing", palette = palette_sharing,
remove_y = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls"), limits = c(-0, .4),
collapse_content = TRUE)
ggarrange(self_within, social_within, ncol = 2, labels = c("A", "B"), widths = c(.51, .49))ggarrange(self_between, social_between, self_within, social_within,
ncol = 2, nrow = 2, labels = c("A", "B", "C", "D"), widths = c(.51, .49, .51, .49))self_between_subset = plot_sca(data = filter(output1, grepl("self between", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(1, 1), text_size = 18,
color_vars = "medium", palette = palette[3:4],
remove_facet = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls", "subset"), limits = c(-.3, 1),
collapse_content = TRUE)
social_between_subset= plot_sca(data = filter(output1, grepl("social between", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(.5, 1), text_size = 18,
color_vars = "medium", palette = palette[3:4],
remove_y = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls", "subset"), limits = c(-.3, 1),
collapse_content = TRUE)
ggarrange(self_between_subset, social_between_subset, ncol = 2, labels = c("A", "B"), widths = c(.51, .49))self_within_subset = plot_sca(data = filter(output1, grepl("self within", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(1, 1), text_size = 18,
color_vars = "sharing", palette = palette_sharing,
remove_facet = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls", "subset"), limits = c(-0, .4),
collapse_content = TRUE)
social_within_subset = plot_sca(data = filter(output1, grepl("social within", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(1, 1), text_size = 18,
color_vars = "sharing", palette = palette_sharing,
remove_y = TRUE, labels = c("", ""), median_size = 1,
choices = c("content", "medium", "sharing", "controls", "subset"), limits = c(-0, .4),
collapse_content = TRUE)
ggarrange(self_within_subset, social_within_subset, ncol = 2, labels = c("A", "B"), widths = c(.51, .49))plot_sca(data = filter(output1, grepl("self between", x)), combined = TRUE, title = TRUE,
ci_alpha = 1, alpha_values = c(1, 1), text_size = 18,
color_vars = "medium", palette = palette[3:4],
choices = c("content", "medium", "sharing", "controls"), limits = c(-.3, 1),
collapse_content = TRUE)n_models = output1 %>%
filter(relevance == "self within")
output1 %>%
mutate(positive = ifelse(estimate > 0, 1, 0),
negative = ifelse(estimate < 0, 1, 0),
sig = case_when(conf.low > 0 ~ 1,
conf.high < 0 ~ 1,
TRUE ~ 0),
positive_significant = ifelse(positive == 1 & sig == 1, 1, 0),
negative_significant = ifelse(negative == 1 & sig == 1, 1, 0)) %>%
group_by(relevance) %>%
summarize(min = min(estimate),
max = max(estimate),
median = median(estimate),
positive = (sum(positive) / nrow(n_models)) * 100,
negative = (sum(negative) / nrow(n_models)) * 100,
positive_significant = (sum(positive_significant) / nrow(n_models)) * 100,
negative_significant = (sum(negative_significant) / nrow(n_models)) * 100) %>%
mutate(range = sprintf("%.2f, %.2f", min, max)) %>%
select(relevance, median, range, positive, negative, positive_significant, negative_significant) %>%
knitr::kable(digits = 2)| relevance | median | range | positive | negative | positive_significant | negative_significant |
|---|---|---|---|---|---|---|
| self between | 0.46 | 0.23, 0.74 | 100.00 | 0.00 | 100.00 | 0 |
| self within | 0.16 | 0.07, 0.22 | 100.00 | 0.00 | 100.00 | 0 |
| social between | 0.14 | -0.08, 0.27 | 90.11 | 9.89 | 64.01 | 0 |
| social within | 0.14 | 0.09, 0.30 | 100.00 | 0.00 | 100.00 | 0 |
n_broadcast = output1 %>%
filter(sharing == "broadcast") %>%
filter(relevance == "self between")
n_narrowcast = output1 %>%
filter(sharing == "narrowcast") %>%
filter(relevance == "self between")
output1 %>%
mutate(positive = ifelse(estimate > 0, 1, 0),
negative = ifelse(estimate < 0, 1, 0),
sig = case_when(conf.low > 0 ~ 1,
conf.high < 0 ~ 1,
TRUE ~ 0),
positive_significant = ifelse(positive == 1 & sig == 1, 1, 0),
negative_significant = ifelse(negative == 1 & sig == 1, 1, 0)) %>%
group_by(relevance, sharing) %>%
summarize(min = min(estimate),
max = max(estimate),
median = median(estimate),
positive = sum(positive),
negative = sum(negative),
positive_significant = sum(positive_significant),
negative_significant = sum(negative_significant)) %>%
gather(item, value, contains("positive"), contains("negative")) %>%
mutate(value = ifelse(sharing == "broadcast", (value / nrow(n_broadcast)) * 100, (value / nrow(n_narrowcast)) * 100),
range = sprintf("%.2f, %.2f", min, max)) %>%
spread(item, value) %>%
select(sharing, relevance, median, range, positive, negative, positive_significant, negative_significant) %>%
knitr::kable(digits = 2)| sharing | relevance | median | range | positive | negative | positive_significant | negative_significant |
|---|---|---|---|---|---|---|---|
| broadcast | self between | 0.46 | 0.23, 0.74 | 100.00 | 0.00 | 100.00 | 0 |
| narrowcast | self between | 0.46 | 0.23, 0.53 | 100.00 | 0.00 | 100.00 | 0 |
| broadcast | self within | 0.17 | 0.07, 0.22 | 100.00 | 0.00 | 100.00 | 0 |
| narrowcast | self within | 0.12 | 0.11, 0.13 | 100.00 | 0.00 | 100.00 | 0 |
| broadcast | social between | 0.10 | -0.08, 0.27 | 84.48 | 15.52 | 45.91 | 0 |
| narrowcast | social between | 0.14 | 0.11, 0.22 | 100.00 | 0.00 | 95.83 | 0 |
| broadcast | social within | 0.14 | 0.09, 0.19 | 100.00 | 0.00 | 100.00 | 0 |
| narrowcast | social within | 0.22 | 0.15, 0.30 | 100.00 | 0.00 | 100.00 | 0 |
n_social = output1 %>%
filter(medium == "social media") %>%
filter(relevance == "self between")
n_newspaper = output1 %>%
filter(medium == "newspaper") %>%
filter(relevance == "self between")
output1 %>%
mutate(positive = ifelse(estimate > 0, 1, 0),
negative = ifelse(estimate < 0, 1, 0),
sig = case_when(conf.low > 0 ~ 1,
conf.high < 0 ~ 1,
TRUE ~ 0),
positive_significant = ifelse(positive == 1 & sig == 1, 1, 0),
negative_significant = ifelse(negative == 1 & sig == 1, 1, 0)) %>%
group_by(relevance, medium) %>%
summarize(min = min(estimate),
max = max(estimate),
median = median(estimate),
positive = sum(positive),
negative = sum(negative),
positive_significant = sum(positive_significant),
negative_significant = sum(negative_significant)) %>%
gather(item, value, contains("positive"), contains("negative")) %>%
mutate(value = ifelse(medium == "social media", (value / nrow(n_social)) * 100, (value / nrow(n_newspaper)) * 100),
range = sprintf("%.2f, %.2f", min, max)) %>%
spread(item, value) %>%
select(medium, relevance, median, range, positive, negative, positive_significant, negative_significant) %>%
knitr::kable(digits = 2)| medium | relevance | median | range | positive | negative | positive_significant | negative_significant |
|---|---|---|---|---|---|---|---|
| newspaper | self between | 0.48 | 0.41, 0.74 | 100.00 | 0.00 | 100.00 | 0 |
| social media | self between | 0.32 | 0.23, 0.36 | 100.00 | 0.00 | 100.00 | 0 |
| newspaper | self within | 0.15 | 0.11, 0.22 | 100.00 | 0.00 | 100.00 | 0 |
| social media | self within | 0.16 | 0.07, 0.17 | 100.00 | 0.00 | 100.00 | 0 |
| newspaper | social between | 0.11 | -0.08, 0.20 | 85.94 | 14.06 | 48.83 | 0 |
| social media | social between | 0.17 | 0.15, 0.27 | 100.00 | 0.00 | 100.00 | 0 |
| newspaper | social within | 0.19 | 0.10, 0.30 | 100.00 | 0.00 | 100.00 | 0 |
| social media | social within | 0.14 | 0.09, 0.16 | 100.00 | 0.00 | 100.00 | 0 |
social between